Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/dispms/dispmsg.bas

BASIC Source File | 1995-10-23 | 5KB | 143 lines

' This section is required for the Rufan Redi DisplayMessage processing !

Type POINTAPI
  X As Integer
  Y As Integer
End Type
Type RECT
  X As Integer
  Y As Integer
  Width As Integer
  Height As Integer
End Type

Global lpPoint As POINTAPI
Global lpRect As RECT

Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)

'End of Rufan Redi DisplayMessage section

Sub DisplayMessage (Formname As Form)
  'This procedure is the Rufan Redi DisplayMessage control

  ' Pause the timer
  Formname.MessageTimer.Enabled = False
  ' Initialise variables
  MessageFound% = False
  MessageTemp% = 0

  ' Locate the pointer, and find the size of the client area of the current form
  Call GetCursorPos(lpPoint)
  Call GetClientRect(Formname.hWnd, lpRect)
  ' Use that information to find the poisiotn on the form that the pointer is at
  WindowX = (lpPoint.X * Screen.TwipsPerPixelX) - Formname.Left + ((lpRect.Width * Screen.TwipsPerPixelX) - Formname.Width)
  WindowY = (lpPoint.Y * Screen.TwipsPerPixelY) - Formname.Top + ((lpRect.Height * Screen.TwipsPerPixelY) - Formname.Height)

  ' Loop to find a matching button
  While MessageFound% = False And MessageTemp% < Formname.Count

    Select Case Formname.Controls(MessageTemp%).Tag
      ' Ignore objects with certain (or empty) tags
    Case "Timer", "Printer", "Line", "Status Bar", ""
    Case Else
        ' check to see if the pointer is over the object
      If Formname.Controls(MessageTemp%).Left <= WindowX And Formname.Controls(MessageTemp%).Left + Formname.Controls(MessageTemp%).Width >= WindowX Then
        If Formname.Controls(MessageTemp%).Top <= WindowY And Formname.Controls(MessageTemp%).Top + Formname.Controls(MessageTemp%).Height >= WindowY Then
          Formname.Message.Caption = Formname.Controls(MessageTemp%).Tag
          MessageFound% = True
        End If
      End If
    End Select

    MessageTemp% = MessageTemp% + 1

  Wend

  ' If no object is current, reset the message to the forms tag
  If MessageFound% = False Or Trim$(Formname.Message.Caption) = "" Then
    Formname.Message.Caption = Formname.Tag
  End If

  ' Restart the timer
  Formname.MessageTimer.Enabled = True

End Sub

Sub ReadMe ()
' DisplayMessage (c) Rufan Redi Productions 1994
' Version 1.0 - 5 May 94

' - A section of VB3.0 code which may be included in your
' program to provide a user-definable message box which
' shows a description of the form object that the pointer
' is resting over.
' It's very small, very simple and probably easy to
' improve on, but - you've got it, why not try using it !

' In order to make it work you must do the following;
' 1 - Include this Module in your code
' 2 - Add a Timer - called MessageTimer - to each form you
'     want to have this function on. By default this should
'     be disabled, with an Interval of 250. If this slows
'     your application down, increase the number
' 3 - Add a Label - called Message - to each form with one
'     of these Timers on - set it's size and attributes to
'     fit your application
' 4 - Set the MessageTimer_Timer event to
'     Call DisplayMessage(xxxx) where xxxx is the name of
'     the form
' 5 - Set the Form_Activate event to
'     MessageTimer.Enabled = True
'     and the Form_Deactive event to
'     MessageTimer.Enabled = False
' 6 - Set the tag property for the form to the default
'     message
' 7 - Set the tag properties for each object you want to
'     display a message for. Do not set tags for Timer,
'     Line, Common Dialog or Printer objects.
' 8 - Run your application, and fine tune the messages

' Tag values can be updated in the code. The next time the
' Message is displayed for that object, the new tag will
' be reflected

' You can manually update the message by setting
' DisplayMessage.Caption to the text you want. Remember
' that if the MessageTimer.Enabled = True, that the
' message will be updated after the specified interval

' Apart from DISPMSG.BAS - Declarations, DisplayMessage
' and this ReadMe there are no other pre-requisites

' If you decide to use this in an application, please do
' two things;
' a) Credit me in an appropriate place in your application
' b) and send me a suitable donation to help me contine
'    the work !

' If you have problems, please contact me, preferably via
' CompuServe or physical mail, and preferably with a
' zipped copy of the code you are having problems with
' - I respond better to those who have made, or promise to
' make donations !

' Please feel free to distribute this source - if you
' improve it, please comment the changes, and always
' distribute a copy of the unaltered original. If you do
' improve on this, please also send me a copy !

' I accept no responsibility or liability for anything you
' do with this code, or anything that happens as a result
' of using in in it's original, or any modified forms.

' I am Jeremy E Cath
' Address: Stoke Cottage, Marsh Lane, Taplow, Maidenhead,
'          Berkshire. United Kingdom. SL6 0DF
' Phone/Fax [phone]
' CompuServe: 100315,521
' Internet: [e-mail]
End Sub